home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / Clinic / HLLabel.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-09-16  |  2.2 KB  |  100 lines
  1. unit HLLabel;
  2.  
  3. {$ifdef Ver80} { Delphi 1.0x }
  4.   {$define DelphiLessThan3}
  5. {$endif}
  6. {$ifdef Ver90} { Delphi 2.0x }
  7.   {$define DelphiLessThan3}
  8. {$endif}
  9. {$ifdef Ver93} { C++ Builder 1.0x }
  10.   {$define DelphiLessThan3}
  11. {$endif}
  12.  
  13. interface
  14.  
  15. uses
  16.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  17.   Forms, Dialogs, StdCtrls;
  18.  
  19. type
  20.   THyperLinkLabel = class(TCustomLabel)
  21.   private
  22.     FHyperlinkColour, FOldColour: TColor;
  23.     FHyperlinkStyle, FOldStyle: TFontStyles;
  24.   protected
  25.     procedure Click; override;
  26.     procedure CMMouseEnter(var Msg: TMessage);
  27.       message cm_MouseEnter;
  28.     procedure CMMouseLeave(var Msg: TMessage);
  29.       message cm_MouseLeave;
  30.   public
  31.     constructor Create(AOwner: TComponent); override;
  32.   published
  33.     property HyperlinkColour: TColor
  34.       read FHyperlinkColour write FHyperlinkColour default clBlue;
  35.     property HyperlinkStyle: TFontStyles
  36.       read FHyperlinkStyle write FHyperlinkStyle;
  37.     property Caption;
  38. {$ifndef DelphiLessThan3}
  39.     property Cursor default crHandPoint;
  40. {$endif}
  41.     property Font;
  42.     property ParentShowHint;
  43.     property ShowHint;
  44.     property OnClick;
  45.   end;
  46.  
  47. procedure Register;
  48.  
  49. implementation
  50.  
  51. uses
  52.   ShellAPI;
  53.  
  54. procedure Register;
  55. begin
  56.   RegisterComponents('Clinic', [THyperLinkLabel]);
  57. end;
  58.  
  59. { THyperLinkLabel }
  60.  
  61. constructor THyperLinkLabel.Create(AOwner: TComponent);
  62. begin
  63.   inherited Create(AOwner);
  64. {$ifndef DelphiLessThan3}
  65.   Cursor := crHandPoint;
  66. {$endif}
  67.   FHyperlinkColour := clBlue;
  68.   FHyperlinkStyle := [fsUnderline];
  69.   FOldColour := Font.Color;
  70.   FOldStyle := Font.Style;
  71. end;
  72.  
  73. procedure THyperLinkLabel.Click;
  74. var
  75.   { For PChar version of URL. Written for Delphi 1 compatibility }
  76.   URLBuf: array[0..255] of Char;
  77. begin
  78.   inherited Click;
  79.   StrPCopy(URLBuf, Caption);
  80.   ShellExecute(Application.Handle, nil, URLBuf, nil, nil, sw_ShowNormal)
  81. end;
  82.  
  83. procedure THyperLinkLabel.CMMouseEnter(var Msg: TMessage);
  84. begin
  85.   inherited;
  86.   FOldStyle := Font.Style;
  87.   FOldColour := Font.Color;
  88.   Font.Style := FHyperlinkStyle;
  89.   Font.Color := FHyperlinkColour;
  90. end;
  91.  
  92. procedure THyperLinkLabel.CMMouseLeave(var Msg: TMessage);
  93. begin
  94.   inherited;
  95.   Font.Style := FOldStyle;
  96.   Font.Color := FOldColour;
  97. end;
  98.  
  99. end.
  100.